PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/viaray.com/VIARAY.PAS

Pascal/Delphi Source File | 1990-11-09 | 18.1 KB | 465 lines

unit ViAray;  { John Haluska,  CIS 74000,1106 }      { Turbo Pascal 5.0, 5.5 }
{$R-,S-,V-,I+,B-,F-,A+,D+,N-,L+}

{ Ver 1.0  10/1/90  Released to public domain  }

{ This unit is derived from Buffered Generic VirtualArray Object, a public
  domain program by Eric C. Wentz, CIS 72070,1015.

  The ViAray unit is a high performance virtual array manager which uses
  8 RAM buffers to access a data array in a disk file.  Each array element may
  be any type and have a size of 1 to 32767 bytes.  The array size (element
  size times number of elements) is limited only by the DOS file size limit
  (typically 32 MBytes).  The data file contains the data array only.  Typical
  use:

   1.  Define the array element data structure (integer, real, record, etc).
   2.  Define a fatal error exit procedure.  See Error procedure for example.
   3.  Prepare for a new or existing array, the number of elements, element
       size, RAM buffer size, and array file name with the Init procedure.  An
       array must be prepared with Init before any of the following procedures
       can be used.
   4.  Write data into an array element with the Accept procedure.
   5.  Read data from an array element with the Retrieve procedure.
   6.  Exchange data between two array elements with the Swap procedure.
   7.  Increase number of array elements and/or change RAM buffer size with
       the ReSize procedure.
   8.  Transfer contents of one array element to another array element for the
       same or different arrays with the Copy procedure.
   9.  Remove RAM buffer and close array file with the Done procedure.
  10.  Remove RAM buffer and delete array file with the Destroy procedure.

  Each VirArray variable is allocated 8 sectors with each sector having 1/8 of
  the specified RAM buffer assigned to it.  Buffers freely move within their
  assigned sector, but they can never read from or write to adjacent sectors.
  To save access time, a buffer never writes to disk unless the buffer data
  has been changed, with the exception of the ReSize, Done and Destroy
  procedures, which write all buffers of the VirArray variable to disk.

  The maximum total buffer size is 524,168 bytes, and is determined by
  available heap RAM and by the GetMem limit of 65521 bytes for a single
  structure.

  There are 3 major influences on the performance characteristics of the
  VirArray.  The first is load factor or the actual percentage of the disk
  file which resides in RAM.  The second is the size of the individual buffers
  themselves.  As the size of the buffers increases, the time required to read
  or write each buffer from or to disk also increases.  With a high load factor
  this is not much of a problem, but with a low load factor and a lot of random
  accesses, much time will be spent reading or writing buffers.  The third is
  proportional to the file size, and is the time required to seek a random
  address within the file before reading or writing.  Serial and closely
  spaced accessing is always quite good unless the buffers are very small.  }

interface

uses
  Dos;

const
  ErrMsg : string[79] = '';                              {termination message}

type

  Space  = array[0..0] of byte;              {abstract 0 based array of bytes}

  VirArray = record                 {do not modify record variables directly!}
    ElSize    : word;                            {bytes in each array element}
    NumElems  : longint;                            {number of array elements}
    Name      : PathStr;                       {filename with drive/directory}
    DriveNum  : word;                      {disk drive number (1=A, 2=B, etc)}
    F         : file;                                 {assigned file variable}
    BSize     : word;                         {bytes in each of 8 RAM buffers}
    SSize     : longint;       {(ElSize*NumElems)/8; adj for partial elements}
    Buffer    : array[0..7] of ^Space;               {addr of each RAM buffer}
    UpDate    : array[0..7] of boolean; {true if file data <> RAM buffer data}
    BuffLeft  : array[0..7] of longint;          {1st byte of each RAM buffer}
  end;

procedure Init(var V : VirArray; NewArray : boolean; NumElements : longint;
               ElementSize : word; MaxBuffSize : longint; FileName : PathStr);
procedure Accept(var V : VirArray; var ElData; Index : longint);
procedure Retrieve(var V : VirArray; var ElData; Index : longint);
procedure Copy(var V1,V2 : VirArray; I1,I2 : longint);
procedure Swap(var V : VirArray; I,J : longint);
procedure ReSize(var V : VirArray; NumElements,MaxBuffSize : longint);
procedure Done(var V : VirArray);
procedure Destroy(var V : VirArray);

implementation

const
  MaxRamBuffer = 524168;   {8 * 65521}

{----------------------------------------------------------------------------}
{ Error places message number N with string St in unit global variable ErrMsg
  and terminates program when this procedure is called.  The ErrMsg string is
  typically used in an exit procedure in the main program.  }

(*  Example:   var
                 ExitSave : pointer;
               {$F+} procedure PrgmExit;
                 begin
                   ExitProc := ExitSave;
                   if ErrMsg <> '' then Writeln(#13,#10,ErrMsg);
                 end;  {$F-}
               begin {Main}
                 ExitSave := ExitProc;
                 ExitProc := @PrgmExit;
                 ----
               end.  {Main}    *)

procedure Error(N : byte; St : string);

begin
  case N of
     1 : ErrMsg := 'Unable to open file '+ St;
     2 : ErrMsg := 'Array element sizes do not match for operation '+ St;
     3 : ErrMsg := 'Index out of bounds for operation ' + St;
     4 : ErrMsg := 'Array file not open';
     6 : ErrMsg := 'Insufficient free disk space for operation ' + St;
     7 : ErrMsg := 'Insufficient RAM for operation ' + St;
    10 : ErrMsg := 'Buffer size too small or insufficient memory';
  end;
  Halt(0)
end;  {Error}
{----------------------------------------------------------------------------}
{ InBuff returns true if array V element Index is in RAM buffer Buff.  }

function InBuff(var V : VirArray; Index : longint; Buff : byte) : boolean;

var
  L : longint;
begin
  L := Index*V.ElSize;
  if (L >= V.BuffLeft[Buff]) and (L < (V.BuffLeft[Buff] + V.BSize)) then
    InBuff := true
  else
    InBuff := false
end;  {InBuff}
{----------------------------------------------------------------------------}
{ FlushBuff writes array V RAM buffer number Buff to disk file.  }

procedure FlushBuff(var V : VirArray; Buff : byte);

begin
  Seek(V.F,V.BuffLeft[Buff]);
  BlockWrite(V.F,V.Buffer[Buff]^,V.BSize)
end;  {FlushBuff}
{----------------------------------------------------------------------------}
{ RemoveBuffers stores all 8 RAM buffers into array V disk file and
  deallocates RAM.  }

procedure RemoveBuffers(var V : VirArray);
var
  I : byte;
begin
  for I := 0 to 7 do
    begin
      FlushBuff(V,I);
      FreeMem(V.Buffer[I],V.BSize)
    end
end;  {RemoveBuffers}
{----------------------------------------------------------------------------}
{ LoadBuff reads array V data from disk file into RAM buffer number Buff. }

procedure LoadBuff(var V : VirArray; Buff : byte);

begin
  Seek(V.F,V.BuffLeft[Buff]);
  BlockRead(V.F,V.Buffer[Buff]^,V.BSize)
end;  {LoadBuff}
{----------------------------------------------------------------------------}
{ MoveBuff writes RAM buffer number Buff to disk if it has been changed.
  MoveBuff then sets the location of RAM buffer number Buff so that array V
  element Index is in the middle of Buff.  If necessary, Buff location is
  adjusted to keep it in the array sector assigned to Buff.  MoveBuff then
  reads data from disk file into Buff.}

procedure MoveBuff(var V : VirArray; Index : longint; Buff : byte);

var
  Base,J : longint;
begin
  if V.UpDate[Buff] then
    begin                              {write data in RAM buffer to disk file}
      FlushBuff(V,Buff);
      V.UpDate[Buff] := false
    end;
  if V.BSize > V.ElSize then      {each RAM buffer contains multiple elements}
    begin
      Base := (Index * V.ElSize) - (V.BSize div 2);     {center Buff on Index}
      Base := Base - (Base mod V.ElSize);     {start Buff on Element boundary}
      case Buff of             {if reqd, clamp Buff at top of assigned sector}
        0..6 : begin
                 J := V.SSize * (Buff+1);
                 if (Base + V.BSize) >= J then Base := J - V.BSize
               end;
           7 : begin
                 J := V.NumElems * V.ElSize;
                 if (Base + V.BSize) >= J then Base := J - V.BSize
               end
      end;
      J := V.SSize * Buff;
      if Base < J then Base := J     {if reqd, clamp Buff at bottom of sector}
    end
  else
    Base := Index * V.ElSize;             {each RAM buffer contains 1 element}
  V.BuffLeft[Buff] := Base;
  LoadBuff(V,Buff)
end;  {MoveBuff}
{----------------------------------------------------------------------------}
{ Sector returns the sector number (0-7) of the RAM buffer for array V element
  Index. }

function Sector(var V : VirArray; Index : longint) : byte;

var
  I : integer;
  Test,Temp : longint;
begin
  I := -1;
  Test := 0;
  Temp := V.ElSize * Index;
  while Test <= Temp do
    begin
      Inc(I);
      Inc(Test,V.SSize)
    end;
  if I > 7 then I := 7;
  Sector := byte(I)
end;  {Sector}
{----------------------------------------------------------------------------}
{ SetupBuffers initializes the SSize/BSize variables, the BuffLeft/UpDate
  arrays, and allocates the RAM buffers for array V.  }

procedure SetupBuffers(var V : VirArray; BuffSize : longint);

var
  TotData : longint;
  Buffers : byte;
begin
  if BuffSize = 0 then BuffSize := MaxAvail - 1024;     {max heap - 1024}
  if BuffSize > MaxRamBuffer then BuffSize := MaxRamBuffer;
  TotData := V.ElSize * V.NumElems;
  V.BSize := BuffSize div 8;
  if (longint(V.BSize) * 8) > TotData then
    V.BSize := TotData div 8;            {all array elements fit in RAM buffer}
  V.SSize := TotData div 8;
  V.SSize := V.SSize - (V.SSize mod V.ElSize);   {partial elements not allowed}
  if V.BSize > V.SSize then V.BSize := V.SSize; {all array elements fit in RAM}
  V.BSize := V.BSize - (V.BSize mod V.ElSize);   {partial elements not allowed}
  if (V.BSize <= 0) or (V.SSize <= 0) then Error(10,'');
  for Buffers := 0 to 7 do                                   {init RAM buffers}
    begin
      V.BuffLeft[Buffers] := Buffers*V.SSize;
      GetMem(V.Buffer[Buffers],V.BSize);
      if V.Buffer[Buffers] = nil then Error(7,'SetupBuffers');
      LoadBuff(V,Buffers);
      V.UpDate[Buffers] := false
    end;
end;  {SetupBuffers}
{----------------------------------------------------------------------------}
{ Initialize RAM buffers and open disk file for a new (NewArray = true) or
  existing (NewArray = false) array V with NumElements elements, ElementSize
  size in bytes, MaxBuffSize (in bytes) of RAM buffer, and disk file FileName.
  FileName can include the drive and directory.  If MaxBuffSize = 0 then all
  available RAM, less 1KB, will be used.  If an existing array, NumElements
  can be any number.  Remove RAM buffers and close disk file with Done or
  Destroy procedures.
  Example:  var A : VirArray; Init(A,true,2000,2,1000,'A.DAT') initializes a
  new array[0..1999] with elements of 2 bytes each and a RAM buffer of 1000
  bytes stored in diskfile A.DAT.  }

procedure Init(var V : VirArray; NewArray : boolean; NumElements : longint;
               ElementSize : word; MaxBuffSize : longint; FileName : PathStr);
var
  TotData,J,K : longint;
  Buff : ^Space;
  L,BuffSize : word;

begin

  {---Setup File---}
  V.Name := FExpand(FileName);
  V.DriveNum := Ord(V.Name[1]) - 64;         {drive number 1 = A, 2 = B, etc}
  if NewArray then
    begin
      TotData := NumElements*ElementSize;
      if TotData > DiskFree(V.DriveNum) then Error(6,'Init')
    end;
  Assign(V.F,V.Name);
  {$I-} if NewArray then Rewrite(V.F,1) else Reset(V.F,1); {$I+}
  if IOResult <> 0 then Error(1,V.Name);
  if NewArray then
    begin
      if TotData < 65521 then BuffSize := word(TotData) else BuffSize := 65521;
      if BuffSize > MaxAvail then BuffSize := MaxAvail;
      if BuffSize = 0 then Error(7,'Init');
      GetMem(Buff,BuffSize);
      for L := 0 to BuffSize-1 do Buff^[L] := 0;        {init buffer contents}
      K := TotData div BuffSize;
      for J := 0 to K-1 do                                   {TotData > 65521}
        BlockWrite(V.F,Buff^,BuffSize);
      L := word(TotData - (K*BuffSize));
      if L >= 0 then        {(TotData <= 65521) or (TotData mod BuffSize > 0)}
        BlockWrite(V.F,Buff^,L);
      FreeMem(Buff,BuffSize)
    end
  else
    begin
      TotData := FileSize(V.F);
      if TotData mod ElementSize <> 0 then Error(2,'Init existing array')
        else NumElements := TotData div ElementSize;
    end;

  {---Setup Buffers---}
  V.NumElems := NumElements;
  V.ElSize := ElementSize;
  SetupBuffers(V,MaxBuffSize);
end;  {Init}
{----------------------------------------------------------------------------}
{ Accept loads data ElData into array V element Index.  ElData can be a
  variable of any type (real, integer, record, etc) with element size
  specified by the Init procedure.

  Example: type  ElTyp = record        (16 bytes)
                   Name : string[11];
                   ID   : longint;
                 end;
           var  A : VirArray;  D : ElTyp;

           D.Name := 'Smith';  D.Id := 12345;
           Accept(A,D,34);  loads Smith, 12345 into array A element 34   }

procedure Accept(var V : VirArray; var ElData; Index : longint);

var
  Buf : Space absolute ElData;
  Sect : byte;
begin
  if (Index >= V.NumElems) or (Index < 0) then Error(3,'Accept');
  Sect := Sector(V,Index);
  if not InBuff(V,Index,Sect) then MoveBuff(V,Index,Sect);
  Move(Buf,V.Buffer[Sect]^[(Index*V.ElSize)-V.BuffLeft[Sect]],V.ElSize);
  V.UpDate[Sect] := true
end;  {Accept}
{----------------------------------------------------------------------------}
{ Retrieve data ElData from array V element Index. }

procedure Retrieve(var V : VirArray; var ElData; Index : longint);

var
  Buf : Space absolute ElData;
  Sect : byte;
begin
  if (Index >= V.NumElems) or (Index < 0) then Error(3,'Retrieve');
  Sect := Sector(V,Index);
  if not InBuff(V,Index,Sect) then MoveBuff(V,Index,Sect);
  Move(V.Buffer[Sect]^[(Index*V.ElSize)-V.BuffLeft[Sect]],Buf,V.ElSize)
end;  {Retrieve}
{----------------------------------------------------------------------------}
{ Copy array V1 element I1 to array V2 element I2.  Arrays V1 and V2 may be
  the same array.  If different arrays, each array must have the same element
  size.  Example:  var A1,A2 : VirArray;  Copy(A1,A2,1,20) copies array A1
  element 1 into array A2 element 20.}

procedure Copy(var V1,V2 : VirArray; I1,I2 : longint);

var
  T1 : ^Space;
begin
  if V1.ElSize <> V2.ElSize then Error(2,'Copy');
  GetMem(T1,V1.ElSize);
  if T1 = nil then Error(7,'Copy');
  Retrieve(V1,T1^,I1);
  Accept(V2,T1^,I2);
  FreeMem(T1,V1.ElSize)
end;  {Copy}
{----------------------------------------------------------------------------}
{ Swap data in array V elements I and J.  Example:  var A : VirArray;
  Swap(A,5,10)  exchanges data between array elements 5 and 10.  }

procedure Swap(var V : VirArray; I,J : longint);

var
  T1,T2 : ^Space;
begin
  GetMem(T1,V.ElSize);
  GetMem(T2,V.ElSize);
  if (T1=nil) or (T2=nil) then Error(7,'Swap');
  Retrieve(V,T1^,I);
  Retrieve(V,T2^,J);
  Accept(V,T1^,J);
  Accept(V,T2^,I);
  FreeMem(T1,V.ElSize);
  FreeMem(T2,V.ElSize)
end;  {Swap}
{----------------------------------------------------------------------------}
{ ReSize increases the number of array V elements NumElements and changes the
  MaxBuffSize in bytes of the RAM buffer in array V.  Array V must be
  initialized with Init. }

procedure ReSize(var V : VirArray; NumElements,MaxBuffSize : longint);

var
  ElemIncr,K,J : longint;
  L,BufSize : word;
  Buf : ^Space;

begin
  RemoveBuffers(V);                             {remove existing RAM buffers}
  if NumElements > V.NumElems then
    begin
      ElemIncr := (NumElements - V.NumElems) * V.ElSize;
      if DiskFree(V.DriveNum) < ElemIncr then Error(6,'ReSize');
      if ElemIncr < 65521 then BufSize := word(ElemIncr) else BufSize := 65521;
      if BufSize > MaxAvail then BufSize := MaxAvail;
      GetMem(Buf,BufSize);
      for L := 0 to BufSize-1 do Buf^[L] := 0;          {init element contents}
      Seek(V.F,FileSize(V.F));              {move file position to end of file}
      K := ElemIncr div BufSize;
      for J := 0 to K-1 do                                   {ElemIncr > 65521}
        BlockWrite(V.F,Buf^,BufSize);
      L := word(ElemIncr - (K*BufSize));
      if L >= 0 then       {(ElemIncr <= 65521) or (ElemIncr mod BuffSize > 0)}
        BlockWrite(V.F,Buf^,L);
      FreeMem(Buf,BufSize);
    end;
  V.NumElems := NumElements;
  SetupBuffers(V,MaxBuffSize)                               {setup RAM buffers}
end; {ReSize}
{----------------------------------------------------------------------------}
{ Done stores array V RAM buffers to disk, deallocates heap memory and closes
  the array file.  Example:  var A : VirArray;  Store(A);  }

procedure Done(var V : VirArray);

begin
  RemoveBuffers(V);
  {$I-} Close(V.F);  {$I+}
  if IOResult <> 0 then Error(4,'')
end;  {Done}
{----------------------------------------------------------------------------}
{ Destroy (delete) the array V file on disk, remove RAM buffers, and
  deallocate heap memory.  Example:  var A : VirArray;  Destroy(A);  }

procedure Destroy(var V : VirArray);

begin
  Done(V);
  Erase(V.F);
end;  {Destroy}
{----------------------------------------------------------------------------}
{ HeapErrorTrap causes New and GetMem to return nil if out of heap memory. }

{$F+} function HeapErrorTrap(Size : word) : integer;

begin
  HeapErrorTrap := 1
end; {$F-}
{----------------------------------------------------------------------------}
begin
  HeapError := @HeapErrorTrap
end. {ViAray}